home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / rot4.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  7KB  |  220 lines
  1. {$N+}
  2.  
  3. program _Rotation;
  4. { Slow rotating sphere, by Bas van Gaalen, Holland, PD }
  5. uses
  6.   crt,dos;
  7.  
  8. const
  9.   ScrBase : word = $a000;
  10.   NofPoints = 100;
  11.   Speed = 5;
  12.   Xc : real = 0;
  13.   Yc : real = 0;
  14.   Zc : real = 150;
  15.   SinTab : array[0..255] of integer = (
  16.     0,2,5,7,10,12,15,17,20,22,24,27,29,31,34,36,38,41,43,45,47,49,52,54,
  17.     56,58,60,62,64,66,67,69,71,73,74,76,78,79,81,82,83,85,86,87,88,90,91,
  18.     92,93,93,94,95,96,97,97,98,98,99,99,99,100,100,100,100,100,100,100,
  19.     100,99,99,99,98,98,97,97,96,95,95,94,93,92,91,90,89,88,87,85,84,83,
  20.     81,80,78,77,75,73,72,70,68,66,65,63,61,59,57,55,53,51,48,46,44,42,40,
  21.     37,35,33,30,28,26,23,21,18,16,14,11,9,6,4,1,-1,-4,-6,-9,-11,-14,-16,
  22.     -18,-21,-23,-26,-28,-30,-33,-35,-37,-40,-42,-44,-46,-48,-51,-53,-55,
  23.     -57,-59,-61,-63,-65,-66,-68,-70,-72,-73,-75,-77,-78,-80,-81,-83,-84,
  24.     -85,-87,-88,-89,-90,-91,-92,-93,-94,-95,-95,-96,-97,-97,-98,-98,-99,
  25.     -99,-99,-100,-100,-100,-100,-100,-100,-100,-100,-99,-99,-99,-98,-98,
  26.     -97,-97,-96,-95,-94,-93,-93,-92,-91,-90,-88,-87,-86,-85,-83,-82,-81,
  27.     -79,-78,-76,-74,-73,-71,-69,-67,-66,-64,-62,-60,-58,-56,-54,-52,-49,
  28.     -47,-45,-43,-41,-38,-36,-34,-31,-29,-27,-24,-22,-20,-17,-15,-12,-10,
  29.     -7,-5,-2,0);
  30.  
  31. type
  32.   PointRec = record
  33.                X,Y,Z : integer;
  34.              end;
  35.   PointPos = array[0..NofPoints] of PointRec;
  36.  
  37. var
  38.   Point : PointPos;
  39.  
  40. {----------------------------------------------------------------------------}
  41.  
  42. procedure SetGraphics(Mode : byte); assembler;
  43. asm mov AH,0; mov AL,Mode; int 10h; end;
  44.  
  45. {----------------------------------------------------------------------------}
  46.  
  47. procedure Init;
  48.  
  49. const
  50.   CoorTab : array[0..199,0..2] of integer = (
  51. (6,50,2),(14,45,18),(25,39,-18),(-28,14,39),
  52. (11,33,36),(-11,36,33),(25,34,26),(41,-29,-4),(40,-28,11),
  53. (7,33,36),(-9,17,-46),(-28,-40,-12),(-3,25,-43),(16,32,35),
  54. (-26,-27,33),(-35,19,-30),(4,36,-34),(27,41,7),(29,-39,14),
  55. (-41,-28,-6),(31,-32,-23),(32,34,-18),(-25,-27,-34),(-19,-46,0),
  56. (41,-27,-7),(-42,13,-23),(-5,-47,-17),(-36,-34,8),(-23,2,44),
  57. (-27,-25,34),(-25,-32,29),(-39,22,22),(41,19,20),(29,25,-32),
  58. (10,49,-4),(9,-48,-10),(39,-31,3),(16,32,35),(-39,-19,-24),
  59. (-25,-36,-25),(-26,8,-42),(-20,45,-5),(34,-21,30),(-40,30,2),
  60. (-39,31,3),(17,24,40),(34,-35,9),(-26,32,28),(-50,-1,3),
  61. (31,-14,36),(30,32,-24),(-21,45,4),(31,-8,-38),(-35,26,-24),
  62. (-5,-31,-39),(-17,4,-47),(-37,18,-29),(-36,11,33),(45,22,-5),
  63. (38,31,9),(43,-20,-17),(16,-44,-17),(11,35,-34),(16,-32,-35),
  64. (-34,-31,19),(-26,40,17),(-21,37,26),(30,32,-24),(6,-47,15),
  65. (40,-23,-19),(44,5,-23),(6,-29,40),(8,-28,-40),(25,43,4),
  66. (29,31,26),(-44,20,12),(-14,31,37),(9,-26,41),(-27,34,-25),
  67. (-12,45,19),(-3,-37,-33),(-32,2,-38),(-11,41,-26),(1,47,-18),
  68. (-25,0,-44),(-24,-44,3),(3,-50,-1),(-11,31,37),(2,32,-39),
  69. (-39,29,13),(42,28,0),(-4,-40,29),(21,-15,-43),(-9,45,-20),
  70. (-10,-23,-43),(33,-11,36),(14,-31,-36),(15,48,-3),(41,6,-28),
  71. (-25,-18,-39),(-33,33,-16),(-44,20,14),(-9,44,22),(11,-24,43),
  72. (-20,21,-41),(-36,-18,-30),(11,38,-30),(17,31,-36),(-49,-5,5),
  73. (-36,-34,-6),(-8,-29,40),(-7,26,-42),(23,-21,39),(46,-8,18),
  74. (-1,-10,49),(37,5,-33),(-12,-45,-19),(-27,-42,-5),(36,33,9),
  75. (-27,22,36),(29,-28,-29),(25,28,-33),(6,11,-48),(23,39,20),
  76. (1,-37,34),(36,-32,-14),(-47,13,-10),(28,-39,-13),(-26,-13,41),
  77. (7,-46,-17),(11,33,-36),(-36,-34,2),(29,24,33),(11,40,-28),
  78. (-19,41,22),(34,-35,-12),(-27,-32,-27),(50,-1,-3),(-17,-35,32),
  79. (-30,11,-38),(12,7,48),(-43,25,9),(-25,37,24),(-30,-36,-17),
  80. (-36,-16,30),(29,-36,-19),(-42,18,21),(18,-12,45),(-25,33,28),
  81. (12,39,-29),(-37,-32,10),(-32,-4,38),(38,19,-27),(-23,-22,38),
  82. (25,42,12),(22,-38,23),(2,-49,-7),(40,31,1),(38,22,23),
  83. (18,-32,-34),(-25,29,-32),(10,25,42),(-25,42,-12),(36,24,26),
  84. (21,44,-9),(32,35,15),(17,16,-44),(-43,-21,14),(-31,21,33),
  85. (-29,3,-40),(35,-35,2),(-18,43,17),(-2,38,-32),(-17,-32,-34),
  86. (18,-31,-35),(-32,6,38),(-29,40,4),(-17,37,29),(42,-26,-6),
  87. (-43,-17,19),(-43,-19,17),(29,-26,31),(-6,38,-31),(-33,-24,29),
  88. (33,28,25),(39,-24,19),(-40,-16,-26),(-19,-29,-36),(46,15,14),
  89. (-21,31,-33),(-24,-38,-22),(-36,-35,1),(-29,-22,34),(-34,-34,-12),
  90. (14,33,35),(6,50,-1),(-14,48,-3),(6,2,50),(13,46,-15),
  91. (1,-27,42));
  92.  
  93. var
  94.   I : byte;
  95.  
  96. begin
  97.   randomize;
  98.   for I := 0 to NofPoints do begin
  99.     Point[I].X := CoorTab[I,0];
  100.     Point[I].Y := CoorTab[I,1];
  101.     Point[I].Z := CoorTab[I,2];
  102.   end;
  103. end;
  104.  
  105. {----------------------------------------------------------------------------}
  106.  
  107. procedure InitColors;
  108.  
  109. var
  110.   I : byte;
  111.  
  112.   procedure SetColor(Color,Red,Green,Blue : byte);
  113.  
  114.   begin
  115.     port[$3C8] := Color;
  116.     port[$3C9] := Red;
  117.     port[$3C9] := Green;
  118.     port[$3C9] := Blue;
  119.   end;
  120.  
  121. begin
  122.   for I := 0 to 63 do SetColor(I+1,0,I,I);
  123. end;
  124.  
  125. {----------------------------------------------------------------------------}
  126.  
  127. procedure DoRotation;
  128.  
  129. const
  130.   Xstep = 0;
  131.   Ystep = 2;
  132.   Zstep = 0;
  133.  
  134. var
  135.   Xp,Yp : array[0..NofPoints] of word;
  136.   X,Y,Z,X1,Y1,Z1 : real;
  137.   PhiX,PhiY,PhiZ : byte;
  138.   I,Color : byte;
  139.  
  140. function Sinus(Idx : byte) : real;
  141.  
  142. begin
  143.   Sinus := SinTab[Idx]/100;
  144. end;
  145.  
  146. function Cosinus(Idx : byte) : real;
  147.  
  148. begin
  149.   Cosinus := SinTab[(Idx+192) mod 255]/100;
  150. end;
  151.  
  152. begin
  153.   PhiX := 0; PhiY := 0; PhiZ := 0;
  154.   repeat
  155.     while (port[$3da] and 8) <> 8 do;
  156.     while (port[$3da] and 8) = 8 do;
  157.     for I := 0 to NofPoints do begin
  158.  
  159.       if (Xp[I]+160 < 320) and (Yp[I]+100 < 200) then
  160.         mem[$a000:(Yp[I]+100)*320+Xp[I]+160] := 0;
  161.  
  162.       {
  163.       asm
  164.         push ds
  165.  
  166.         xor bh,bh
  167.         mov bl,I
  168.         mov ax,word ptr offset Yp
  169.         add ax,100
  170.         mov cx,320
  171.         mul cx
  172.  
  173.         mov cx,word ptr offset Xp
  174.         add cx,160
  175.         add ax,cx
  176.  
  177.         mov di,ax
  178.         mov es,ScrBase
  179.  
  180.         mov al,50
  181.         stosb
  182.  
  183.         pop ds
  184.       end;
  185.       }
  186.  
  187.       X1 := Cosinus(PhiY)*Point[I].X-Sinus(PhiY)*Point[I].Z;
  188.       Z1 := Sinus(PhiY)*Point[I].X+Cosinus(PhiY)*Point[I].Z;
  189.       X := Cosinus(PhiZ)*X1+Sinus(PhiZ)*Point[I].Y;
  190.       Y1 := Cosinus(PhiZ)*Point[I].Y-Sinus(PhiZ)*X1;
  191.       Z := Cosinus(PhiX)*Z1-Sinus(PhiX)*Y1;
  192.       Y := Sinus(PhiX)*Z1+Cosinus(PhiX)*Y1;
  193.  
  194.       Xp[I] := round((Xc*Z-X*Zc)/(Z-Zc));
  195.       Yp[I] := round((Yc*Z-Y*Zc)/(Z-Zc));
  196.       if (Xp[I]+160 < 320) and (Yp[I]+100 < 200) then begin
  197.         Color := 30+round(Z/5);
  198.         {if Color > 31 then Color := 31
  199.         else if Color < 16 then Color := 16;}
  200.         mem[$a000:(Yp[I]+100)*320+Xp[I]+160] := Color;
  201.       end;
  202.  
  203.       {inc(Point[I].Z,Speed); if Point[I].Z > 125 then Point[I].Z := -125;}
  204.     end;
  205.     inc(PhiX,Xstep);
  206.     inc(PhiY,Ystep);
  207.     inc(PhiZ,Zstep);
  208.   until keypressed;
  209. end;
  210.  
  211. {----------------------------------------------------------------------------}
  212.  
  213. begin
  214.   SetGraphics($13);
  215.   Init;
  216.   InitColors;
  217.   DoRotation;
  218.   textmode(lastmode);
  219. end.
  220.